import qualified Data.Map as Map
import Data.List (union, findIndex)
import qualified Data.Set as Set

splitAll :: Eq a => [a] -> [a] -> [[a]]
splitAll _ [] = []
splitAll delims xs = 
    token : splitAll delims rest
    where
        isDelimiter = (`elem` delims)
        token       = takeWhile (not . isDelimiter) xs
        rest        = dropWhile isDelimiter $ dropWhile (not . isDelimiter) xs

type RuleID = Int
data Rule = Literal Char
          | And [RuleID]
          | AndOr [RuleID] [RuleID]
            deriving (Show)

type RuleMap = Map.Map RuleID Rule

isNothing :: Maybe a -> Bool 
isNothing Nothing = True
isNothing _ = False

-- 77: "a"
-- 64: 77 99 | 91 119
-- 23: 88 32

parseRule :: String -> Rule
parseRule str
    | isLiteral = Literal (head . tail $ str)
    | otherwise = case maybeIdx of
        Nothing  -> And $ toRuleIDs str
        Just idx -> AndOr (toRuleIDs lrule) (toRuleIDs rrule)
            where
                lrule = take (idx - 1) str
                rrule = drop (idx + 2) str
    where
        isLiteral = (=='"') $ head str  

        maybeIdx = findIndex (=='|') $ str

        toRuleIDs :: String -> [RuleID]
        toRuleIDs = map read . splitAll " "


parseIDRule :: String -> (RuleID, Rule)
parseIDRule str = (read ruleIDStr, parseRule ruleStr)
    where
        ruleIDStr = takeWhile (/=':') str
        ruleStr = drop (length ruleIDStr + 2) str

parseInput :: String -> (RuleMap, [String])
parseInput str = (rules, messages)
    where
        tokens = splitAll [""] $ lines str
        rules = Map.fromList . map parseIDRule . head $ tokens
        messages = last tokens

unwrap :: Maybe a -> a
unwrap (Just v) = v

type Record = Map.Map RuleID [String]

patternList :: RuleMap -> RuleID -> [String]
patternList rules id = fst $ rulePattern (id, Map.empty)
    where
        rulePattern :: (RuleID, Record) -> ([String], Record)
        rulePattern (id, record) = case maybePattern of
            Just res -> (res, record)
            Nothing  -> case rule of
                Literal c -> (res, Map.insert id res record)
                    where
                        res = [c:""]
                And ids -> (res, Map.insert id res record')
                    where
                        (res, record') = andRulePattern (ids, record)
                AndOr ids1 ids2 -> (res, Map.insert id res record'')
                    where
                        (res1, record')  = andRulePattern (ids1, record)
                        (res2, record'') = andRulePattern (ids2, record')
                        res = union res1 res2
            where
                maybePattern = Map.lookup id record
                rule = getRule id

        andRulePattern :: ([RuleID], Record) -> ([String], Record)
        andRulePattern (ids, record) = foldl foldFunc ([""], record) ids
            where
                foldFunc :: ([String], Record) -> RuleID -> ([String], Record)
                foldFunc (acc, record) id = (connectPattern acc pattern, record')
                    where
                        (pattern, record') = rulePattern (id, record)

        connectPattern :: [String] -> [String] -> [String]
        connectPattern [] s2 = []
        connectPattern (s1:ss1) ss2 = (map (s1++) ss2) ++ connectPattern ss1 ss2
                
        getRule :: RuleID -> Rule
        getRule id = unwrap . Map.lookup id $ rules

main :: IO () 
main = do
    input <- readFile "input.txt"
    let (rules, messages) = parseInput input
    let patterns = Set.fromList $ patternList rules 0 
    print . length 
          . filter (\m -> Set.member m patterns) 
          $ messages